home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / frmdoc1a / docprevi.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1999-07-31  |  37.8 KB  |  1,027 lines
  1. VERSION 5.00
  2. Begin VB.Form frmDocPreview 
  3.    BackColor       =   &H8000000B&
  4.    BorderStyle     =   1  'Fixed Single
  5.    Caption         =   "Preview"
  6.    ClientHeight    =   6510
  7.    ClientLeft      =   1125
  8.    ClientTop       =   1500
  9.    ClientWidth     =   9780
  10.    Icon            =   "DocPreview.frx":0000
  11.    LinkTopic       =   "Form1"
  12.    LockControls    =   -1  'True
  13.    MaxButton       =   0   'False
  14.    MinButton       =   0   'False
  15.    PaletteMode     =   1  'UseZOrder
  16.    ScaleHeight     =   434
  17.    ScaleMode       =   3  'Pixel
  18.    ScaleWidth      =   652
  19.    Begin VB.CommandButton cmdZoomOut 
  20.       Height          =   405
  21.       Left            =   1680
  22.       Picture         =   "DocPreview.frx":030A
  23.       Style           =   1  'Graphical
  24.       TabIndex        =   18
  25.       ToolTipText     =   "Zoom out"
  26.       Top             =   60
  27.       Width           =   405
  28.    End
  29.    Begin VB.CommandButton cmdZoomIn 
  30.       Height          =   405
  31.       Left            =   1200
  32.       Picture         =   "DocPreview.frx":040C
  33.       Style           =   1  'Graphical
  34.       TabIndex        =   17
  35.       ToolTipText     =   "Zoom in"
  36.       Top             =   60
  37.       Width           =   405
  38.    End
  39.    Begin VB.CommandButton cmdPrint 
  40.       Height          =   405
  41.       Left            =   270
  42.       Picture         =   "DocPreview.frx":050E
  43.       Style           =   1  'Graphical
  44.       TabIndex        =   16
  45.       ToolTipText     =   "Print"
  46.       Top             =   60
  47.       Width           =   405
  48.    End
  49.    Begin VB.ComboBox cboScale 
  50.       BeginProperty Font 
  51.          Name            =   "MS Sans Serif"
  52.          Size            =   9.75
  53.          Charset         =   0
  54.          Weight          =   400
  55.          Underline       =   0   'False
  56.          Italic          =   0   'False
  57.          Strikethrough   =   0   'False
  58.       EndProperty
  59.       Height          =   360
  60.       Left            =   2220
  61.       Style           =   2  'Dropdown List
  62.       TabIndex        =   15
  63.       Top             =   60
  64.       Width           =   855
  65.    End
  66.    Begin VB.CommandButton cmdPrevPage 
  67.       Caption         =   "<"
  68.       BeginProperty Font 
  69.          Name            =   "MS Sans Serif"
  70.          Size            =   8.25
  71.          Charset         =   0
  72.          Weight          =   700
  73.          Underline       =   0   'False
  74.          Italic          =   0   'False
  75.          Strikethrough   =   0   'False
  76.       EndProperty
  77.       Height          =   345
  78.       Left            =   4200
  79.       TabIndex        =   14
  80.       ToolTipText     =   "Prev page"
  81.       Top             =   90
  82.       Width           =   315
  83.    End
  84.    Begin VB.CommandButton cmdNextPage 
  85.       Caption         =   ">"
  86.       BeginProperty Font 
  87.          Name            =   "MS Sans Serif"
  88.          Size            =   8.25
  89.          Charset         =   0
  90.          Weight          =   700
  91.          Underline       =   0   'False
  92.          Italic          =   0   'False
  93.          Strikethrough   =   0   'False
  94.       EndProperty
  95.       Height          =   345
  96.       Left            =   4560
  97.       TabIndex        =   13
  98.       ToolTipText     =   "Next page"
  99.       Top             =   90
  100.       Width           =   315
  101.    End
  102.    Begin VB.ComboBox cboPageNo 
  103.       BeginProperty Font 
  104.          Name            =   "MS Sans Serif"
  105.          Size            =   9.75
  106.          Charset         =   0
  107.          Weight          =   400
  108.          Underline       =   0   'False
  109.          Italic          =   0   'False
  110.          Strikethrough   =   0   'False
  111.       EndProperty
  112.       Height          =   360
  113.       Left            =   4890
  114.       Style           =   2  'Dropdown List
  115.       TabIndex        =   12
  116.       Top             =   60
  117.       Width           =   825
  118.    End
  119.    Begin VB.TextBox txtTotalPages 
  120.       BackColor       =   &H80000004&
  121.       BeginProperty Font 
  122.          Name            =   "MS Sans Serif"
  123.          Size            =   9.75
  124.          Charset         =   0
  125.          Weight          =   400
  126.          Underline       =   0   'False
  127.          Italic          =   0   'False
  128.          Strikethrough   =   0   'False
  129.       EndProperty
  130.       Height          =   345
  131.       Left            =   5760
  132.       Locked          =   -1  'True
  133.       TabIndex        =   11
  134.       Text            =   "txtTotalPages"
  135.       Top             =   60
  136.       Width           =   1395
  137.    End
  138.    Begin VB.CommandButton cmdClose 
  139.       Caption         =   "Close"
  140.       BeginProperty Font 
  141.          Name            =   "MS Sans Serif"
  142.          Size            =   8.25
  143.          Charset         =   0
  144.          Weight          =   700
  145.          Underline       =   0   'False
  146.          Italic          =   0   'False
  147.          Strikethrough   =   0   'False
  148.       EndProperty
  149.       Height          =   390
  150.       Left            =   8190
  151.       TabIndex        =   10
  152.       Top             =   60
  153.       Width           =   825
  154.    End
  155.    Begin VB.PictureBox PicZ 
  156.       BackColor       =   &H8000000D&
  157.       Height          =   5325
  158.       Left            =   60
  159.       ScaleHeight     =   5265
  160.       ScaleWidth      =   9285
  161.       TabIndex        =   2
  162.       Top             =   720
  163.       Width           =   9345
  164.       Begin VB.PictureBox Pic5 
  165.          BackColor       =   &H80000009&
  166.          Height          =   2295
  167.          Left            =   120
  168.          ScaleHeight     =   2235
  169.          ScaleWidth      =   2595
  170.          TabIndex        =   9
  171.          Top             =   120
  172.          Width           =   2655
  173.       End
  174.       Begin VB.PictureBox Pic4 
  175.          AutoRedraw      =   -1  'True
  176.          BackColor       =   &H80000009&
  177.          Height          =   2715
  178.          Left            =   150
  179.          ScaleHeight     =   2655
  180.          ScaleWidth      =   3015
  181.          TabIndex        =   8
  182.          Top             =   120
  183.          Width           =   3075
  184.       End
  185.       Begin VB.PictureBox Pic3 
  186.          AutoRedraw      =   -1  'True
  187.          BackColor       =   &H80000009&
  188.          Height          =   3285
  189.          Left            =   120
  190.          ScaleHeight     =   3225
  191.          ScaleWidth      =   3765
  192.          TabIndex        =   7
  193.          Top             =   90
  194.          Width           =   3825
  195.       End
  196.       Begin VB.PictureBox Pic2 
  197.          AutoRedraw      =   -1  'True
  198.          BackColor       =   &H80000009&
  199.          Height          =   3795
  200.          Left            =   90
  201.          ScaleHeight     =   3735
  202.          ScaleWidth      =   4515
  203.          TabIndex        =   6
  204.          Top             =   60
  205.          Width           =   4575
  206.       End
  207.       Begin VB.PictureBox Pic1 
  208.          AutoRedraw      =   -1  'True
  209.          BackColor       =   &H80000009&
  210.          Height          =   4215
  211.          Left            =   60
  212.          ScaleHeight     =   4155
  213.          ScaleWidth      =   5325
  214.          TabIndex        =   5
  215.          Top             =   30
  216.          Width           =   5385
  217.       End
  218.       Begin VB.PictureBox PicX 
  219.          AutoRedraw      =   -1  'True
  220.          BackColor       =   &H80000009&
  221.          Height          =   4695
  222.          Left            =   30
  223.          ScaleHeight     =   4635
  224.          ScaleWidth      =   6015
  225.          TabIndex        =   4
  226.          Top             =   0
  227.          Width           =   6075
  228.       End
  229.       Begin VB.PictureBox picP 
  230.          AutoRedraw      =   -1  'True
  231.          BackColor       =   &H80000009&
  232.          Height          =   5310
  233.          Left            =   0
  234.          ScaleHeight     =   5250
  235.          ScaleWidth      =   6885
  236.          TabIndex        =   3
  237.          Top             =   -30
  238.          Width           =   6945
  239.       End
  240.    End
  241.    Begin VB.VScrollBar VScroll1 
  242.       Height          =   5295
  243.       Left            =   9420
  244.       Max             =   500
  245.       TabIndex        =   0
  246.       Top             =   720
  247.       Width           =   330
  248.    End
  249.    Begin VB.HScrollBar HScroll1 
  250.       Height          =   330
  251.       Left            =   60
  252.       Max             =   500
  253.       TabIndex        =   1
  254.       Top             =   6060
  255.       Width           =   9345
  256.    End
  257. Attribute VB_Name = "frmDocPreview"
  258. Attribute VB_GlobalNameSpace = False
  259. Attribute VB_Creatable = False
  260. Attribute VB_PredeclaredId = True
  261. Attribute VB_Exposed = False
  262. '  DocPreview.frm
  263. '  By Herman Liu
  264. '  VB has not provided facilities to build print preview for RichTextBox which is used
  265. '  as document in a text editor.  Though there are a few print preview programs around,
  266. '  I have not come across any which is geared for RTB in VB context (If a programmer has
  267. '  to arbitrarily apply his/her own selected fonts, the resultant printout would never
  268. '  be able to reflect the document's original settings).
  269. '  Despite VB does not have something like MFC, and despite the many constraints of RTB
  270. '  in VB, we will see that we are able to add functions to RTB for a print preview &/or
  271. '  for printing page(s) selectively. This DocPreview shows how.
  272. '  The Source code is written in native VB. Forms and controls involved are: (1) MDI
  273. '  called frmFrame. A child form, called DocMaster, which contains a RTB. It is from
  274. '  this child form that the DocPreview is invoked . (2) a form for print preview, with
  275. '  MDIChild property set to False.  This DocPreview contains a "home-made" viewport which
  276. '  consists of several pictureboxes.  Controls placed outside the viewport are a horizontal
  277. '  scrollbar and a vertical scrollbar.  On top of the viewport are buttons and comboboxes:
  278. '  a "Zoom-in" button, a "Zoom-out" button, a combobox for preview sizes, another for list
  279. '  of available pages, a "Previous page" button, a "Next page" button, a "Print"  button
  280. '  and a "Close" button.
  281. '  A default value is given to gleftmargin, grightmargin, gtopmargin and gbottommargin
  282. '  respectively (a PageSetUp form shall allow users to change the values).
  283. '  Explanation of some key points:
  284. '  1.  In a RTB, a single line may have text formatted with different fonts, and there
  285. '      may be graphics in between as well. To capture the original contents and settings,
  286. '      we first "selprint" the selected page to a hidden picturebox (Since RTB does not
  287. '      have a hDC, we cannot "bitblt", nor paintpicture").  We then "stretchblt" that
  288. '      picturebox to other pictureboxes according to the desired sizes of preview.
  289. '      (SretchBlt differs to BitBlt in that it will stretch/shrink according to the
  290. '      scalewidth and scaleheight of the destination relative to the source).
  291. '  2.  Since selprint method does not allow a programmer to set the position of output on
  292. '      the printer. In addition, RTB does not provide a method for displaying its contents
  293. '      as they should show up on the printer. We have to set up a RTB similar to a WYSIWYG
  294. '      display before printing it.
  295. '  3.  Pictureboxes inside the viewport: PicZ is the base for all other pictureboxes. In
  296. '      order for the viewport to work, all these other pictureboxes must be placed inside
  297. '      PicZ only. At design stage, align all pictureboxes to a top-left corner of PicZ.
  298. '      N.B.: Before that, place PicP, PixX, 1, 2, 3, 4 & 5 individually inside PicZ first
  299. '      (but outside any other picturebox).  You don't have to size them as they will be
  300. '      resized at runtime (except for the base PicZ).
  301. '  4.  Before user is provided with options to select a particular page, there should be
  302. '      procedural mechanism to establish the total no. of pages.  There should also be
  303. '      arrangements to effect change of a user-selected page, both for display and for
  304. '      print to printer.
  305. '  All the above-mentioned are included in this sample program and the program can be run
  306. '  readily.
  307. '  You are allowed to use this program freely, but I would appreciate a due credit given.
  308. '  Please let me know if you have made any enhancement.
  309. Option Explicit
  310. Private Declare Function StretchBlt Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, _
  311.     ByVal Y As Long, ByVal mDestWidth As Long, ByVal mDestHeight As Long, _
  312.     ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal mSrcWidth As Long, _
  313.     ByVal mSrcHeight As Long, ByVal dwRop As Long) As Long
  314. Private Const SRCCOPY = &HCC0020
  315. '-------------------------------------------------------------------------------------------------------------------
  316. ' By using the following messages in VB, it is possible to make a RichTextBox support WYSIWYG display and output:
  317. ' EM_SETTARGETDEVICE message is used to tell a RichTextBox to base its display on a target device.
  318. ' EM_FORMATRANGE message sends a page at a time to an output device using the specified coordinates.
  319. Private Type Rect
  320.     Left As Long
  321.     Top As Long
  322.     Right As Long
  323.     Bottom As Long
  324. End Type
  325. Private Type CharRange
  326.     firstChar As Long         ' First character of range (0 for start of doc)
  327.     lastChar As Long          ' Last character of range (-1 for end of doc)
  328. End Type
  329. Private Type FormatRange
  330.     hdc As Long               ' Actual DC to draw on
  331.     hdcTarget As Long         ' Target DC for determining text formatting
  332.     rectRegion As Rect        ' Region of the DC to draw to (in twips)
  333.     rectPage As Rect          ' Page size of the entire DC (in twips)
  334.     mCharRange As CharRange   ' Range of text to draw (see above user type)
  335. End Type
  336. Private Const WM_USER As Long = &H400
  337. Private Const EM_FORMATRANGE As Long = WM_USER + 57
  338. Private Const EM_SETTARGETDEVICE As Long = WM_USER + 72
  339. Private Declare Function SendMessage Lib "User32" Alias "SendMessageA" _
  340.      (ByVal hwnd As Long, ByVal msg As Long, ByVal wp As Long, Ip As Any) As Long
  341.      
  342. Dim mFormatRange As FormatRange
  343. Dim rectDrawTo As Rect
  344. Dim rectPage As Rect
  345. Dim TextLength As Long
  346. Dim newStartPos As Long
  347. Dim dumpaway As Long
  348.      
  349. Private Declare Function CreateDC Lib "gdi32" Alias "CreateDCA" _
  350.      (ByVal lpDriverName As String, ByVal lpDeviceName As String, _
  351.      ByVal lpOutput As Long, ByVal lpInitData As Long) As Long
  352. '-------------------------------------------------------------------------------------------------------------------
  353. Dim mNotShow As Boolean
  354. Dim mSizeNo As Integer
  355. Dim mTotalPages As Integer
  356. Private Sub Form_Load()
  357.    Screen.MousePointer = vbHourglass
  358.    gprint = False
  359.      ' we don't want the sizes to change after they have been appropriately sized
  360.    PicZ.AutoSize = False             ' Base, always visible
  361.    picP.AutoSize = False             ' For print intermediary, always invisible
  362.    PicX.AutoSize = False             ' For diaplay intermediary, always invisible
  363.    Pic1.AutoSize = False             ' As 150%
  364.    Pic2.AutoSize = False             ' As 100%
  365.    Pic3.AutoSize = False             ' As 75%
  366.    Pic4.AutoSize = False             ' As 50%
  367.    Pic5.AutoSize = False             ' As 25%
  368.        ' By default VB prints in twips. If a Picturebox is using pixels, we have to
  369.        ' convert twips in pixels.  Therefore we fix the size of Pictureboxes before
  370.        ' setting its ScaleMode to pixel (Eash pixel is about 15 twips, depending on
  371.        ' the resolution of device)
  372.       
  373.    Dim mNormalWidth, mNormalHeight
  374.    Dim mAdjFactor
  375.    Dim mRect, mNewRect, mfactor
  376.    Dim mpage As Integer
  377.       ' Render document size in line with that of the printer (but note that doc is
  378.       ' shown on screen without print margins)
  379.    DocWYSIWYG frmFrame.ActiveForm.ActiveControl
  380.       ' Obtain size of the printer
  381.    mNormalWidth = Printer.ScaleWidth
  382.    mNormalHeight = Printer.ScaleHeight
  383.       ' Due to diff of resolution between screen and printer, we may use an adjustment
  384.       ' factor, here we don't have any adjustment
  385.    mAdjFactor = 100 / 100
  386.    mNormalWidth = mNormalWidth * mAdjFactor
  387.    mNormalHeight = mNormalHeight * mAdjFactor
  388.       ' Mark down rectangle area, see remarks later
  389.    mRect = mNormalWidth * mNormalHeight
  390.       ' Make the invisible PicX of the same size as printer
  391.    PicX.Width = mNormalWidth
  392.    PicX.Height = mNormalHeight
  393.      ' Percentage may be expressed in terms of original area (in that case, we have
  394.      ' to derive the width and height from the computed area), or in terms of width
  395.      ' and height themselves.  Here, to stress the point, we apply the percentage
  396.      ' in terms of the area for sizes over 100%, but apply the percentage in terms
  397.      ' of the width and height themselves for sizes are below 100%.
  398.        ' Set 150%
  399.    mNewRect = mRect * (150 / 100)
  400.      ' By what percentage (factor) the width and the height should be reduced in order
  401.      ' to arrive at an area for the new rectangle?
  402.      ' (mNormalWidth * mfactor) * (mNormalHeight * mfactor) = mNewRect (mfactor Square)
  403.      ' * (mNormalWidth * mNormalHeight) = mNewRect
  404.    mfactor = Sqr(mNewRect / (mNormalWidth * mNormalHeight))
  405.    Pic1.Width = CInt(mNormalWidth * mfactor)
  406.    Pic1.Height = CInt(mNormalHeight * mfactor)
  407.        ' Set 100%
  408.    Pic2.Width = PicX.Width
  409.    Pic2.Height = PicX.Height
  410.        
  411.       ' Re remarks earlier, we choose not to derive width and height from area for
  412.       ' sizes below 100%.
  413.        ' Set 75%
  414.    Pic3.Width = CInt(mNormalWidth * 75 / 100)
  415.    Pic3.Height = CInt(mNormalHeight * 75 / 100)
  416.        ' Set 50%
  417.    Pic4.Width = CInt(mNormalWidth * 50 / 100)
  418.    Pic4.Height = CInt(mNormalHeight * 50 / 100)
  419.        ' Set 25%
  420.    Pic5.Width = CInt(mNormalWidth * 25 / 100)
  421.    Pic5.Height = CInt(mNormalHeight * 25 / 100)
  422.      ' Set ScaleMode to pixels.
  423.    frmDocPreview.ScaleMode = vbPixels
  424.    PicZ.ScaleMode = vbPixels
  425.    PicX.ScaleMode = vbPixels
  426.    Pic1.ScaleMode = vbPixels
  427.    Pic2.ScaleMode = vbPixels
  428.    Pic3.ScaleMode = vbPixels
  429.    Pic4.ScaleMode = vbPixels
  430.    Pic5.ScaleMode = vbPixels
  431.      ' Set AutoRedraw to True
  432.    PicZ.AutoRedraw = True
  433.    picP.AutoRedraw = True
  434.    PicX.AutoRedraw = True
  435.    Pic1.AutoRedraw = True
  436.    Pic2.AutoRedraw = True
  437.    Pic3.AutoRedraw = True
  438.    Pic4.AutoRedraw = True
  439.    Pic5.AutoRedraw = True
  440.     ' Set BorderStyle to Fixed Single
  441.    PicZ.BorderStyle = 1
  442.    PicX.BorderStyle = 1
  443.    Pic1.BorderStyle = 1
  444.    Pic2.BorderStyle = 1
  445.    Pic3.BorderStyle = 1
  446.    Pic4.BorderStyle = 1
  447.    Pic5.BorderStyle = 1
  448.     ' Set Fillstyle to Transparent
  449.    PicZ.FillStyle = 1
  450.    picP.FillStyle = 1
  451.    PicX.FillStyle = 1
  452.    Pic1.FillStyle = 1
  453.    Pic2.FillStyle = 1
  454.    Pic3.FillStyle = 1
  455.    Pic4.FillStyle = 1
  456.    Pic5.FillStyle = 1
  457.    ' Backcolor of PicZ is blue (&H8000000D), the rest are white (&H80000009)
  458.    PicZ.BackColor = &H8000000D
  459.    picP.BackColor = &H80000009
  460.    PicX.BackColor = &H80000009
  461.    Pic1.BackColor = &H80000009
  462.    Pic2.BackColor = &H80000009
  463.    Pic3.BackColor = &H80000009
  464.    Pic4.BackColor = &H80000009
  465.    Pic5.BackColor = &H80000009
  466.     ' Before showing first page, test how many pages are there in total in RTB.
  467.    mTotalPages = PageCtnProc(frmDocPreview.PicX)
  468.     ' Display the No. of total pages available
  469.    txtTotalPages.Text = "Total " & CStr(mTotalPages) & " pages"
  470.     ' Enable/disable page movement buttons
  471.    setPageButtons
  472.    Dim i As Integer
  473.    cboPageNo.Clear
  474.    For i = 1 To mTotalPages
  475.        cboPageNo.AddItem i
  476.    Next i
  477.    cboPageNo.Text = cboPageNo.List(0)
  478.       ' Set max of scroll bars
  479.    VScroll1.Max = 1000
  480.    HScroll1.Max = 1000
  481.       ' For ComboBox list
  482.     cboScale.AddItem "150"
  483.     cboScale.AddItem "100"
  484.     cboScale.AddItem "75"
  485.     cboScale.AddItem "50"
  486.     cboScale.AddItem "25"
  487.     cboScale.Text = cboScale.List(4)      ' i.e. 25%
  488.       ' Instead Selprint whole document content such as:
  489.       '   frmFrame.ActiveForm.ActiveControl.SelPrint frmDocPreview.picX.Hdc
  490.       ' we only print a single page at a time.  Initially we show page 1.
  491.       '
  492.       ' Whatever page, we will print it to PicX first (then project to other
  493.       ' pictureboxes according to the sizes they play)
  494.    mpage = 1
  495.    FormPreviewPage frmDocPreview.PicX, mpage
  496.      ' Now stretchblt to wanted sizes.
  497.     For i = 1 To 5
  498.         DoEvents
  499.         If MakeSizes(i) = False Then
  500.             Screen.MousePointer = vbDefault
  501.             Exit Sub
  502.         End If
  503.     Next
  504.     Screen.MousePointer = vbDefault
  505.      
  506.      ' Start display of preview screen.
  507.      ' Note picZ is always visible, picX always not.
  508.     PicZ.Visible = True
  509.     picP.Visible = False
  510.     PicX.Visible = False
  511.     mNotShow = False        ' Show appropriate picture on screen
  512.     mSizeNo = 5             ' i.e. cboScale.List=4, 25%
  513.     ChangePreview
  514. End Sub
  515. Private Sub cboPageNo_click()
  516.     Dim mpage As Integer
  517.     mpage = cboPageNo.ListIndex + 1
  518.     setPageButtons
  519.     Screen.MousePointer = vbHourglass
  520.      ' Print a new page to PicX
  521.     FormPreviewPage frmDocPreview.PicX, mpage
  522.      ' Again have to stretchblt to various sizes.
  523.     Dim i
  524.     For i = 1 To 5
  525.         DoEvents
  526.         If MakeSizes(i) = False Then
  527.             Screen.MousePointer = vbDefault
  528.             Exit Sub
  529.         End If
  530.     Next
  531.      ' Have to change size (and then change back) to refresh display of new screen
  532.      ' During the change, not to show any picture, hence mNotShow is temporarily
  533.      ' set to True
  534.     If mSizeNo = 1 Then
  535.         mSizeNo = 2
  536.         mNotShow = True
  537.         ChangePreview
  538.         mNotShow = False
  539.         mSizeNo = 1
  540.         ChangePreview
  541.     Else
  542.         mSizeNo = mSizeNo - 1
  543.         mNotShow = True
  544.         ChangePreview
  545.         mNotShow = False
  546.         mSizeNo = mSizeNo + 1
  547.         ChangePreview
  548.     End If
  549.     Screen.MousePointer = vbDefault
  550. End Sub
  551. Private Sub cmdPrevPage_Click()
  552.     If mTotalPages = 1 Then
  553.         Exit Sub
  554.     Else
  555.         If Val(cboPageNo.Text) > 1 Then
  556.             cboPageNo.Text = cboPageNo.List(cboPageNo.ListIndex - 1)
  557.             cboPageNo_click
  558.         End If
  559.     End If
  560. End Sub
  561. Private Sub cmdNextPage_Click()
  562.     If mTotalPages = 1 Then
  563.         Exit Sub
  564.     Else
  565.         If Val(cboPageNo.Text) < mTotalPages Then
  566.              cboPageNo.Text = cboPageNo.List(cboPageNo.ListIndex + 1)
  567.              cboPageNo_click
  568.         End If
  569.     End If
  570. End Sub
  571. Private Sub setPageButtons()
  572.     If mTotalPages = 1 Then
  573.         cmdPrevPage.Enabled = False
  574.         cmdNextPage.Enabled = False
  575.     Else
  576.         If Val(cboPageNo.Text) = 1 Then
  577.              cmdPrevPage.Enabled = False
  578.              cmdNextPage.Enabled = True
  579.         ElseIf Val(cboPageNo.Text) = mTotalPages Then
  580.              cmdPrevPage.Enabled = True
  581.              cmdNextPage.Enabled = False
  582.         Else
  583.              cmdPrevPage.Enabled = True
  584.              cmdNextPage.Enabled = True
  585.         End If
  586.     End If
  587. End Sub
  588. Private Sub HScroll1_Change()
  589.    Select Case mSizeNo
  590.       Case 1
  591.           Pic1.Left = -HScroll1.Value
  592.       Case 2
  593.           Pic2.Left = -HScroll1.Value
  594.       Case 3
  595.           Pic3.Left = -HScroll1.Value
  596.       Case 4
  597.           Pic4.Left = -HScroll1.Value
  598.       Case 5
  599.           Pic5.Left = -HScroll1.Value
  600.    End Select
  601. End Sub
  602. Private Sub VScroll1_Change()
  603.    Select Case mSizeNo
  604.       Case 1
  605.           Pic1.Top = -VScroll1.Value
  606.       Case 2
  607.           Pic2.Top = -VScroll1.Value
  608.       Case 3
  609.           Pic3.Top = -VScroll1.Value
  610.       Case 4
  611.           Pic4.Top = -VScroll1.Value
  612.       Case 5
  613.           Pic5.Top = -VScroll1.Value
  614.    End Select
  615. End Sub
  616. Private Sub ChangePreview()
  617.    Select Case mSizeNo
  618.       Case 1
  619.           If mNotShow = False Then
  620.                Pic1.Visible = True
  621.           Else
  622.                Pic1.Visible = False
  623.           End If
  624.           Pic2.Visible = False
  625.           Pic3.Visible = False
  626.           Pic4.Visible = False
  627.           Pic5.Visible = False
  628.       Case 2
  629.           Pic1.Visible = False
  630.           If mNotShow = False Then
  631.                Pic1.Visible = True
  632.           Else
  633.                Pic2.Visible = False
  634.           End If
  635.           Pic2.Visible = True
  636.           Pic3.Visible = False
  637.           Pic4.Visible = False
  638.           Pic5.Visible = False
  639.       Case 3
  640.           Pic1.Visible = False
  641.           Pic2.Visible = False
  642.           If mNotShow = False Then
  643.                Pic3.Visible = True
  644.           Else
  645.                Pic3.Visible = False
  646.           End If
  647.           Pic4.Visible = False
  648.           Pic5.Visible = False
  649.       Case 4
  650.           Pic1.Visible = False
  651.           Pic2.Visible = False
  652.           Pic3.Visible = False
  653.           If mNotShow = False Then
  654.                Pic4.Visible = True
  655.           Else
  656.                Pic4.Visible = False
  657.           End If
  658.           Pic5.Visible = False
  659.       Case 5
  660.           Pic1.Visible = False
  661.           Pic2.Visible = False
  662.           Pic3.Visible = False
  663.           Pic4.Visible = False
  664.           If mNotShow = False Then
  665.                Pic5.Visible = True
  666.           Else
  667.                Pic5.Visible = False
  668.           End If
  669.    End Select
  670. End Sub
  671. ' Combo does not honour "Change", we use "Click" instead
  672. Private Sub cboScale_Click()
  673.     Select Case cboScale.Text
  674.         Case "150"
  675.             mSizeNo = 1
  676.             cmdZoomIn.Enabled = False
  677.             cmdZoomOut.Enabled = True
  678.         Case "100"
  679.             mSizeNo = 2
  680.         Case "75"
  681.             mSizeNo = 3
  682.         Case "50"
  683.             mSizeNo = 4
  684.         Case "25"
  685.             mSizeNo = 5
  686.             cmdZoomIn.Enabled = True
  687.             cmdZoomOut.Enabled = False
  688.     End Select
  689.     If mSizeNo > 1 And mSizeNo < 5 Then
  690.          cmdZoomIn.Enabled = True
  691.          cmdZoomOut.Enabled = True
  692.     End If
  693.     ChangePreview
  694. End Sub
  695. Private Sub cmdPrint_click()
  696.      gprint = True
  697.      Unload Me
  698. End Sub
  699. Private Sub cmdZoomin_click()
  700.      If mSizeNo = 1 Then
  701.           Exit Sub
  702.      End If
  703.      Select Case mSizeNo
  704.           Case 5
  705.                mSizeNo = 4
  706.                cboScale.Text = cboScale.List(3)
  707.                cmdZoomOut.Enabled = True
  708.           Case 4
  709.                mSizeNo = 3
  710.                cboScale.Text = cboScale.List(2)
  711.           Case 3
  712.                mSizeNo = 2
  713.                cboScale.Text = cboScale.List(1)
  714.           Case 2
  715.                mSizeNo = 1
  716.                cboScale.Text = cboScale.List(0)
  717.                cmdZoomIn.Enabled = False
  718.      End Select
  719.      If mSizeNo > 1 And mSizeNo < 5 Then
  720.               cmdZoomIn.Enabled = True
  721.               cmdZoomOut.Enabled = True
  722.      End If
  723.      ChangePreview
  724. End Sub
  725. Private Sub cmdzoomout_click()
  726.     If mSizeNo = 5 Then
  727.          Exit Sub
  728.     End If
  729.     Select Case mSizeNo
  730.          Case 1
  731.               cmdZoomIn.Enabled = True
  732.               mSizeNo = 2
  733.               cboScale.Text = cboScale.List(1)
  734.          Case 2
  735.               mSizeNo = 3
  736.               cboScale.Text = cboScale.List(2)
  737.          Case 3
  738.               mSizeNo = 4
  739.               cboScale.Text = cboScale.List(3)
  740.          Case 4
  741.               mSizeNo = 5
  742.               cboScale.Text = cboScale.List(4)
  743.               cmdZoomOut.Enabled = False
  744.               cmdZoomIn.Enabled = True
  745.      End Select
  746.      If mSizeNo > 1 And mSizeNo < 5 Then
  747.               cmdZoomIn.Enabled = True
  748.               cmdZoomOut.Enabled = True
  749.      End If
  750.      ChangePreview
  751. End Sub
  752. Private Function MakeSizes(ByVal mofSize As Integer) As Boolean
  753.     Dim SrcX As Long, SrcY As Long
  754.     Dim DestX As Long, DestY As Long
  755.     Dim SrcWidth As Long, SrcHeight As Long
  756.     Dim DestWidth As Long, DestHeight As Long
  757.     Dim SrcHDC As Long, DestHDC As Long
  758.     Dim mresult
  759.       
  760.     SrcX = 0: SrcY = 0: DestX = 0: DestY = 0
  761.       
  762.     SrcWidth = PicX.ScaleWidth
  763.     SrcHeight = PicX.ScaleHeight
  764.     SrcHDC = PicX.hdc
  765.    Select Case mofSize
  766.        Case 1
  767.           DestWidth = Pic1.ScaleWidth
  768.           DestHeight = Pic1.ScaleHeight
  769.           DestHDC = Pic1.hdc
  770.           
  771.       Case 2
  772.           DestWidth = Pic2.ScaleWidth
  773.           DestHeight = Pic2.ScaleHeight
  774.           DestHDC = Pic2.hdc
  775.        
  776.       Case 3
  777.           DestWidth = Pic3.ScaleWidth
  778.           DestHeight = Pic3.ScaleHeight
  779.           DestHDC = Pic3.hdc
  780.           
  781.       Case 4
  782.           DestWidth = Pic4.ScaleWidth
  783.           DestHeight = Pic4.ScaleHeight
  784.           DestHDC = Pic4.hdc
  785.       Case 5
  786.           DestWidth = Pic5.ScaleWidth
  787.           DestHeight = Pic5.ScaleHeight
  788.           DestHDC = Pic5.hdc
  789.    End Select
  790.    mresult = StretchBlt(DestHDC, DestX, DestY, DestWidth, DestHeight, SrcHDC, _
  791.       SrcX, SrcY, SrcWidth, SrcHeight, SRCCOPY)
  792.    If mresult = 0 Then
  793.        MsgBox "Error occurred in sizing images. Cannot continue"
  794.        MakeSizes = False
  795.    Else
  796.        MakeSizes = True
  797.    End If
  798. End Function
  799. Private Sub cmdClose_Click()
  800.     Unload Me
  801. End Sub
  802. ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  803. ' To display the same as it would print on the selected printer
  804. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  805. Function DocWYSIWYG(RTB As Control) As Long
  806.      Dim LeftMargin As Long, RightMargin As Long
  807.      Dim linewidth As Long
  808.      Dim PrinterhDC As Long
  809.      Dim r As Long
  810.      Printer.ScaleMode = vbTwips
  811.      LeftMargin = gLeftMargin * 1440
  812.      RightMargin = Printer.Width - gRightMargin * 1440
  813.      linewidth = RightMargin - LeftMargin
  814.      DocWYSIWYG = linewidth
  815. End Function
  816. Sub FormPreviewPage(inControl As Control, InPage As Integer)
  817.     Dim PageCtn
  818.       ' Clear picture box control
  819.     Set inControl.Picture = LoadPicture
  820.       ' Set printable area rect.
  821.       ' Note in frmDocPreview, scaleModes are all in vbPixels,
  822.       ' have to compute the vbtwips equivalent
  823.     rectPage.Left = 0
  824.     rectPage.Top = 0
  825.     rectPage.Right = inControl.Width * Screen.TwipsPerPixelX
  826.     rectPage.Bottom = inControl.Height * Screen.TwipsPerPixelY
  827.       ' Set rect in which to print (relative to printable area)
  828.     rectDrawTo.Left = gLeftMargin * 1440
  829.     rectDrawTo.Top = gTopMargin * 1440
  830.     rectDrawTo.Right = inControl.Width * Screen.TwipsPerPixelX _
  831.          - gRightMargin * 1440
  832.     rectDrawTo.Bottom = inControl.Height * Screen.TwipsPerPixelY _
  833.          - gBottomMargin * 1440
  834.     mFormatRange.hdc = inControl.hdc           ' Use the same DC for measuring and rendering
  835.     mFormatRange.hdcTarget = inControl.hdc     ' Point at hDC
  836.     mFormatRange.rectRegion = rectDrawTo       ' Area on page to draw to
  837.     mFormatRange.rectPage = rectPage           ' Entire size of page
  838.     mFormatRange.mCharRange.firstChar = 0      ' Start of text
  839.     mFormatRange.mCharRange.lastChar = -1      ' End of the text
  840.     TextLength = Len(frmFrame.ActiveForm.ActiveControl.Text)
  841.     PageCtn = 1
  842.     Do
  843.         newStartPos = SendMessage(frmFrame.ActiveForm.ActiveControl.hwnd, EM_FORMATRANGE, True, mFormatRange)
  844.         If newStartPos >= TextLength Then
  845.             Exit Do
  846.         End If
  847.         If PageCtn = InPage Then
  848.             Exit Do
  849.         End If
  850.         
  851.         ' Clear picture box control
  852.         Set inControl.Picture = LoadPicture
  853.        
  854.         mFormatRange.mCharRange.firstChar = newStartPos       ' Starting position for next page
  855.         
  856.         mFormatRange.hdc = inControl.hdc
  857.         mFormatRange.hdcTarget = inControl.hdc
  858.         
  859.         PageCtn = PageCtn + 1
  860.         DoEvents
  861.     Loop
  862.     dumpaway = SendMessage(inControl.hwnd, EM_FORMATRANGE, False, ByVal CLng(0))
  863. End Sub
  864. ' Test how many pages are there in total
  865. Function PageCtnProc(inControl As Control) As Integer
  866.     Dim mPageCtn As Integer
  867.       ' Set printable area rect.
  868.       ' Note in frmDocPreview, scaleModes are all in vbPixels;
  869.       ' convert them to vbtwips.
  870.     rectPage.Left = 0
  871.     rectPage.Top = 0
  872.     rectPage.Right = inControl.Width * Screen.TwipsPerPixelX
  873.     rectPage.Bottom = inControl.Height * Screen.TwipsPerPixelY
  874.       ' Set rect in which to print (relative to printable area)
  875.     rectDrawTo.Left = gLeftMargin * 1440
  876.     rectDrawTo.Top = gTopMargin * 1440
  877.     rectDrawTo.Right = inControl.Width * Screen.TwipsPerPixelX _
  878.          - gRightMargin * 1440
  879.     rectDrawTo.Bottom = inControl.Height * Screen.TwipsPerPixelY _
  880.          - gBottomMargin * 1440
  881.       ' Set up the print instructions
  882.     mFormatRange.hdc = inControl.hdc            ' Use the same DC for measuring and rendering
  883.     mFormatRange.hdcTarget = inControl.hdc      ' Point at hDC
  884.     mFormatRange.rectRegion = rectDrawTo        ' Area on page to draw to
  885.     mFormatRange.rectPage = rectPage            ' Entire size of page
  886.     mFormatRange.mCharRange.firstChar = 0       ' Start of text
  887.     mFormatRange.mCharRange.lastChar = -1       ' End of the text
  888.     TextLength = Len(frmFrame.ActiveForm.ActiveControl.Text)
  889.     mPageCtn = 1
  890.     Do
  891.           ' Print the page by sending EM_FORMATRANGE message
  892.         newStartPos = SendMessage(frmFrame.ActiveForm.ActiveControl.hwnd, EM_FORMATRANGE, True, mFormatRange)
  893.         If newStartPos >= TextLength Then
  894.             Exit Do
  895.         End If
  896.         mFormatRange.mCharRange.firstChar = newStartPos       ' Starting position for next page
  897.         mFormatRange.hdc = inControl.hdc
  898.         mFormatRange.hdcTarget = inControl.hdc
  899.         
  900.         mPageCtn = mPageCtn + 1
  901.         DoEvents
  902.     Loop
  903.      ' Clear picture box control
  904.     Set inControl.Picture = LoadPicture
  905.     dumpaway = SendMessage(inControl.hwnd, EM_FORMATRANGE, False, ByVal CLng(0))
  906.     PageCtnProc = mPageCtn
  907. End Function
  908. Sub DocPrintProc()
  909.     On Error Resume Next
  910.     DoEvents
  911.       ' Clear picture box control
  912.     Set frmDocPreview.picP.Picture = LoadPicture
  913.     Dim mydialog1 As Object
  914.     Dim mFromPage As Integer, mToPage As Integer, mpage As Integer
  915.     Set mydialog1 = frmFrame.CommonDialog1
  916.     mydialog1.DialogTitle = "Print"
  917.     mydialog1.CancelError = True
  918.        ' Allow user select page range
  919.     mydialog1.Flags = cdlPDReturnDC + cdlPDPageNums
  920.        ' But default to one of these
  921.     If frmFrame.ActiveForm.Text1.SelLength = 0 Then
  922.         mydialog1.Flags = mydialog1.Flags + cdlPDAllPages
  923.     Else
  924.         mydialog1.Flags = mydialog1.Flags + cdlPDSelection
  925.     End If
  926.     mydialog1.ShowPrinter
  927.     If Err = MSComDlg.cdlCancel Then
  928.          Exit Sub
  929.     End If
  930.     mFromPage = mydialog1.FromPage
  931.     mToPage = mydialog1.ToPage
  932.     If frmFrame.ActiveForm.WindowState <> 1 Then
  933.         DocWYSIWYG frmFrame.ActiveForm.ActiveControl
  934.         frmFrame.ActiveForm.Move 0, 0
  935.     Else
  936.         MsgBox "Cannot proceed with minimized screen"
  937.         Exit Sub
  938.     End If
  939.     'If MsgBox("Proceed to print", vbYesNo + vbQuestion) = vbNo Then
  940.     '    Exit Sub
  941.     'End If
  942.     Printer.Print ""
  943.     Printer.ScaleMode = vbTwips
  944.       ' Set printable rect area
  945.     rectPage.Left = 0
  946.     rectPage.Top = 0
  947.     rectPage.Right = Printer.ScaleWidth
  948.     rectPage.Bottom = Printer.ScaleHeight
  949.       ' Set rect in which to print (relative to printable area)
  950.     rectDrawTo.Left = gLeftMargin * 1440
  951.     rectDrawTo.Top = gTopMargin * 1440
  952.     rectDrawTo.Right = Printer.ScaleWidth - gRightMargin * 1440
  953.     rectDrawTo.Bottom = Printer.ScaleHeight - gBottomMargin * 1440
  954.      ' Dump earlier pages if any to PicP before reaching first wanted page
  955.     mFormatRange.hdc = frmDocPreview.picP.hdc
  956.     mFormatRange.hdcTarget = frmDocPreview.picP.hdc
  957.     newStartPos = 0                                   ' Next char to start
  958.     mFormatRange.rectRegion = rectDrawTo              ' Area on page to draw to
  959.     mFormatRange.rectPage = rectPage                  ' Entire size of page
  960.     mFormatRange.mCharRange.firstChar = newStartPos   ' Start of text
  961.     mFormatRange.mCharRange.lastChar = -1             ' End of the text
  962.     TextLength = Len(frmFrame.ActiveForm.ActiveControl.Text)
  963.       ' Dumping if any
  964.     mpage = 1
  965.     Do
  966.         If mpage = mFromPage Then
  967.             Exit Do
  968.         End If
  969.         
  970.         ' Don't clear picture box control here, unless you want to print
  971.         ' from first page always.
  972.         
  973.           ' Print the page by sending EM_FORMATRANGE message
  974.         newStartPos = SendMessage(frmFrame.ActiveForm.ActiveControl.hwnd, EM_FORMATRANGE, True, mFormatRange)
  975.         
  976.         If newStartPos >= TextLength Then
  977.             Exit Do
  978.         End If
  979.         
  980.         mFormatRange.mCharRange.firstChar = newStartPos             ' Starting position for next page
  981.         
  982.         mFormatRange.hdc = frmDocPreview.picP.hdc
  983.         mFormatRange.hdcTarget = frmDocPreview.picP.hdc
  984.         
  985.         mpage = mpage + 1
  986.         DoEvents
  987.     Loop
  988.        ' Must cleanse memory here before print, otherwise font will not be right
  989.     dumpaway = SendMessage(Screen.ActiveForm.ActiveControl.hwnd, EM_FORMATRANGE, False, ByVal CLng(0))
  990.     If newStartPos >= TextLength Then
  991.         Exit Sub
  992.     End If
  993.         
  994.        ' Have to reinitialize printer here
  995.     Printer.Print ""
  996.     Printer.ScaleMode = vbTwips
  997.        ' Actual print to printer, starting from the user-selected Page No.
  998.     mFormatRange.hdc = Printer.hdc
  999.     mFormatRange.hdcTarget = Printer.hdc
  1000.       ' Update char range
  1001.     mFormatRange.mCharRange.firstChar = newStartPos
  1002.     Do
  1003.           ' Print the page by sending EM_FORMATRANGE message
  1004.         newStartPos = SendMessage(frmFrame.ActiveForm.ActiveControl.hwnd, EM_FORMATRANGE, True, mFormatRange)
  1005.         If newStartPos >= TextLength Then
  1006.             Exit Do
  1007.         End If
  1008.         If mpage = mToPage Then
  1009.             Exit Do
  1010.         End If
  1011.         
  1012.         mFormatRange.mCharRange.firstChar = newStartPos              ' Starting position for next page
  1013.         
  1014.         Printer.NewPage                  ' Move on to next page
  1015.         Printer.Print ""                 ' Re-initialize hDC
  1016.         mFormatRange.hdc = Printer.hdc
  1017.         mFormatRange.hdcTarget = Printer.hdc
  1018.         
  1019.         mpage = mpage + 1
  1020.         DoEvents
  1021.     Loop
  1022.       ' Commit the print job
  1023.     Printer.EndDoc
  1024.       ' Free up memory
  1025.     dumpaway = SendMessage(Screen.ActiveForm.ActiveControl.hwnd, EM_FORMATRANGE, False, ByVal CLng(0))
  1026. End Sub
  1027.